module Main () where

import Control.Concurrent
import Control.Applicative
import Control.Monad

{-
lots of help from cale to set this up

in ghci:

p <- start
setState p "-"
restart p
stop p
readLog p
restart p
-}

main :: IO ()
main = do
	p <- start
	pause 1
	setState p "-"
	pause 1
	readLog p putStrLn
	restart p
	stop p
	pause 1
	restart p
	setState p "e"
	pause 1
	readLog p putStrLn
	stop p

data Process = P { 
	  stop     :: IO ()
	, readLog  :: (String -> IO ()) -> IO ()
        , setState :: String -> IO ()
        , restart  :: IO ()
	}

start :: IO Process
start = do
	kill    <- newMVar False
        log     <- newMVar ""
        str     <- newMVar "."
 
	let p = P { stop     = modifyMVar_ kill . const $ return True
		  , readLog  = \f -> f =<< readMVar log
		  , setState = \s -> putStrLn ("changing state to " ++ s) >> (modifyMVar_ str . const $ return s)
                  , restart  = do r <- readMVar kill 
                                  if r then do modifyMVar_ kill . const $ return False
				               pRun 
					       putStrLn "restarted"
			               else putStrLn "already running"
		  }

	    pRun = forkIO $ whileM_ (not <$> readMVar kill) $ do
		s <- readMVar str
		g <- readMVar log
		modifyMVar_ log (const $ return (g ++ s))
		pause 0.5

        pRun
	return p

whileM_ :: (Monad m) => m Bool -> m a -> m ()
whileM_ p f = do
        x <- p
        if x then do f
                     whileM_ p f
             else return ()

pause :: RealFrac a => a -> IO ()
pause s = do
	-- putStr "p"
	threadDelay $ round (s * 1000000)